home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 40
/
Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso
/
Aminet
/
misc
/
emu
/
ATUtilities.lha
/
ATUtilities
/
BASIC
/
VISA.BAS
< prev
Wrap
BASIC Source File
|
2000-09-26
|
2KB
|
120 lines
$INCLUDE "REGNAMES.INC"
DEFINT a-Z
REG %AX,(6*256)
CALL INTERRUPT &H49
janus=REG(%DI)
IF di=-1 THEN
?"FEHLER: Janus"
END
END IF
n$="CC:Prgs/F11.cdat"+CHR$(0)
DEF SEG = &HD400
FOR i=1 TO LEN(n$)
POKE janus+i-1,ASC(MID$(n$,i,1))
NEXT
REG %AX,0
REG %BX,1
CALL INTERRUPT &H49
file.okay=REG(%AX)
file.fh=REG(%BX)
IF file.okay<>10000 THEN
?"FEHLER: File"
END
END IF
ON BREAK GOTO ende
REG %AX,2*256
REG %BX,file.fh
REG %CX,8
CALL INTERRUPT &H49
DEF SEG = &HD400
w=(PEEK(janus+4)*256)+PEEK(janus+5)
h=(PEEK(janus+6)*256)+PEEK(janus+7)
s&=w*h
REG %AX,(&H4F*256)+2
IF w=800 THEN
REG %BX,&H103
ELSE
REG %BX,&H101
END IF
CALL INTERRUPT &H10
DEF SEG = &HD400
FOR i=janus TO janus+(3*255)
POKE i,0
NEXT
REG %ES,&HD400
REG %DX,janus
REG %BX,0
REG %CX,255
REG %AX,(&H10*256)+&H12
CALL INTERRUPT &H10
REG %AX,2*256
REG %BX,file.fh
REG %CX,16384
CALL INTERRUPT &H49
bytes=REG(%BX)
p&=0 : d&=0 : s=0
WHILE d&<s&
REG %BX,&HA000
REG %DX,p&
REG %CX,bytes
REG %AX,5*256
CALL INTERRUPT &H49
p&=p&+bytes
d&=d&+bytes
IF p&>65535 THEN
s=s+1
REG %AX,(&H4F*256)+5
REG %BX,0
REG %DX,s
CALL INTERRUPT &H10
p&=0
END IF
IF d&+16384>s& THEN l&=s&-d& ELSE l&=16384
REG %AX,2*256
REG %BX,file.fh
REG %CX,l&
CALL INTERRUPT &H49
bytes=REG(%BX)
WEND
REG %AX,2*256
REG %BX,file.fh
REG %CX,3*255
CALL INTERRUPT &H49
bytes=REG(%BX)
IF bytes<>0 THEN
REG %ES,&HD400
REG %DX,janus
REG %BX,0
REG %CX,255
REG %AX,(&H10*256)+&H12
CALL INTERRUPT &H10
END IF
ende:
IF file.okay=10000 THEN
REG %AX,1*256
REG %BX,file.fh
CALL INTERRUPT &H49
END IF
BEEP
WHILE INKEY$="":WEND
SCREEN 0
CLS
?"<< Taste >>"
END